home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon_Sources / OOP_in_Oberon-2 / Viewers0.mod < prev   
Text File  |  1993-01-13  |  5KB  |  167 lines
  1. MODULE Viewers0;  (*HM Mar-25-92*)
  2. IMPORT OS;
  3.  
  4. CONST
  5.     barH = 14; (*default height of title bar*)
  6.     minH = barH + 2; (*minimal height of a viewer*)
  7.  
  8. TYPE
  9.     Frame* = POINTER TO FrameDesc;
  10.     FrameDesc* = RECORD (OS.ObjectDesc)
  11.         x*, y*: INTEGER; (*left bottom corner in pixels relative to left bottom corner of screen*)
  12.         w*, h*: INTEGER (*width, height in pixels*)
  13.     END;
  14.     Viewer* = POINTER TO ViewerDesc;
  15.     ViewerDesc* = RECORD (FrameDesc)
  16.         menu-, cont-: Frame;
  17.         next-: Viewer;
  18.     END;
  19.  
  20. VAR
  21.     focus-: Frame; (*the frame that gets the keyboard input*)
  22.     viewers: Viewer; (*bottom viewer on the screen*)
  23.  
  24. (*Frame methods*)
  25.  
  26. PROCEDURE (f: Frame) Draw*; END Draw;
  27. PROCEDURE (f: Frame) Modify* (dy: INTEGER); BEGIN INC(f.y, dy); DEC(f.h, dy) END Modify;
  28. PROCEDURE (f: Frame) Move* (dy: INTEGER); BEGIN INC(f.y, dy) END Move;
  29. PROCEDURE (f: Frame) Copy* (): Frame; END Copy;
  30. PROCEDURE (f: Frame) HandleMouse* (x, y: INTEGER; buttons: SET); END HandleMouse;
  31. PROCEDURE (f: Frame) HandleKey* (ch: CHAR); END HandleKey;
  32. PROCEDURE (f: Frame) Handle* (VAR m: OS.Message); END Handle;
  33. PROCEDURE (f: Frame) Defocus*; BEGIN focus := NIL END Defocus;
  34. PROCEDURE (f: Frame) SetFocus*; BEGIN IF focus # NIL THEN focus.Defocus END; focus := f END SetFocus;
  35. PROCEDURE (f: Frame) Neutralize*; END Neutralize;
  36.  
  37.  
  38. (*Viewer methods*)
  39.  
  40. PROCEDURE (v: Viewer) Erase (h: INTEGER);
  41. BEGIN
  42.     IF h > 0 THEN
  43.         OS.EraseBlock(v.x, v.y, v.w, h); (*clear bottom block of viewer*)
  44.         OS.FillBlock(v.x, v.y, 1, h); (*draw left border*)
  45.         OS.FillBlock(v.x+v.w-1, v.y, 1, h) (*draw right border*)
  46.     END;
  47.     OS.FillBlock(v.x, v.y, OS.screenW, 1) (*draw bottom border*)
  48. END Erase;
  49.  
  50. PROCEDURE (v: Viewer) FlipTitleBar;
  51. BEGIN OS.InvertBlock(v.x+1, v.y + v.h - barH, OS.screenW-2, barH)
  52. END FlipTitleBar;
  53.  
  54. PROCEDURE (v: Viewer) Neutralize*;
  55. BEGIN v.menu.Neutralize; v.cont.Neutralize
  56. END Neutralize;
  57.  
  58. PROCEDURE (v: Viewer) Modify* (dy: INTEGER);
  59. BEGIN v.Neutralize; v.Modify^ (dy); v.Erase(-dy+1); v.cont.Modify(dy)
  60. END Modify;
  61.  
  62. PROCEDURE (v: Viewer) Move* (dy: INTEGER);
  63. BEGIN v.Neutralize; v.menu.Move(dy); v.cont.Move(dy);
  64.     OS.CopyBlock(v.x, v.y+1, v.w, v.h-1, v.x, v.y+dy+1);
  65.     INC(v.y, dy)
  66. END Move;
  67.  
  68. PROCEDURE (v: Viewer) Draw*;
  69. BEGIN OS.FadeCursor;
  70.     v.Erase(v.h); v.menu.Draw; v.cont.Draw; v.FlipTitleBar
  71. END Draw;
  72.  
  73. PROCEDURE (v: Viewer) HandleMouse* (x, y: INTEGER; buttons: SET);
  74.     VAR b: SET; x1, y1: INTEGER; dy, maxUp, maxDown: INTEGER;
  75. BEGIN OS.DrawCursor(x, y);
  76.     IF y > v.menu.y THEN (*click in menu bar => resize viewer*)
  77.         IF OS.left IN buttons THEN v.FlipTitleBar;
  78.             REPEAT OS.GetMouse(b, x1, y1); OS.DrawCursor(x1, y1) UNTIL b = {};
  79.             v.FlipTitleBar; OS.FadeCursor; v.Neutralize;
  80.             dy := y1 - y; maxDown := v.h - minH;
  81.             IF v.next = NIL THEN maxUp := OS.screenH - v.y - v.h ELSE maxUp := v.next.h - minH; v.next.Neutralize END;
  82.             IF dy < - maxDown THEN dy := - maxDown ELSIF dy > maxUp THEN dy := maxUp END;
  83.             IF dy < 0 THEN (*down*) v.Modify(-dy); v.Move(dy) ELSE (*up*) v.Move(dy); v.Modify(-dy) END;
  84.             IF v.next # NIL THEN v.next.Modify(dy)
  85.             ELSE OS.EraseBlock(v.x, v.y+v.h, v.w, OS.screenH-v.y-v.h)
  86.             END
  87.         ELSE v.menu.HandleMouse(x, y, buttons)
  88.         END
  89.     ELSE v.cont.HandleMouse(x, y, buttons)
  90.     END
  91. END HandleMouse;
  92.  
  93. PROCEDURE (v: Viewer) Handle* (VAR m: OS.Message);
  94. BEGIN
  95.     v.menu.Handle(m); v.cont.Handle(m)
  96. END Handle;
  97.  
  98. PROCEDURE (v: Viewer) Close*;
  99.     VAR x: Viewer;
  100. BEGIN OS.FadeCursor; v.Neutralize;
  101.     IF v.next # NIL THEN v.next.Modify(-v.h)
  102.     ELSE OS.EraseBlock(v.x, v.y, v.w, v.h)
  103.     END;
  104.     IF viewers = v THEN viewers := v.next
  105.     ELSE x := viewers; WHILE x.next # v DO x := x.next END;
  106.         x.next := v.next
  107.     END
  108. END Close;
  109.  
  110.  
  111. (*external procedures*)
  112.  
  113. PROCEDURE ViewerAt*(y: INTEGER): Viewer;
  114.     VAR v: Viewer;
  115. BEGIN v := viewers;
  116.     WHILE (v # NIL) & (y > v.y + v.h) DO v := v.next END;
  117.     RETURN v
  118. END ViewerAt;
  119.  
  120. PROCEDURE New* (menu, cont: Frame): Viewer;
  121.     VAR below, above, v, w: Viewer; top: INTEGER;
  122. BEGIN
  123.     (*----- compute position of new viewer*)
  124.     IF ViewerAt(OS.screenH) = NIL THEN top := OS.screenH
  125.     ELSE w := viewers; v := viewers.next;
  126.         WHILE v # NIL DO
  127.             IF v.h > w.h THEN w := v END;
  128.             v := v.next
  129.         END;
  130.         top := w.y + w.h DIV 2
  131.     END;
  132.     (*----- generate new viewer and link it into viewer list*)
  133.     above := viewers; below := NIL;
  134.     WHILE (above # NIL) & (top > above.y + above.h) DO below := above; above := above.next END;
  135.     NEW(v); v.x := 0; v.w := OS.screenW; v.next := above;
  136.     IF below = NIL THEN v.y := 0; v.h := top ELSE v.y := below.y + below.h; v.h := top - v.y END;
  137.     IF v.h < minH THEN RETURN NIL END;
  138.     v.menu := menu; menu.x := v.x+1; menu.y := v.y + v.h - barH; menu.w := v.w-2; menu.h := barH-1;
  139.     v.cont := cont; cont.x := v.x+1; cont.y := v.y+1; cont.w := v.w-2; cont.h := menu.y - v.y-1;
  140.     IF below = NIL THEN viewers := v ELSE below.next := v END;
  141.     IF above # NIL THEN above.Modify(v.h) END;
  142.     v.Draw;
  143.     RETURN v
  144. END New;
  145.  
  146. PROCEDURE Broadcast* (VAR m: OS.Message);
  147.     VAR v: Viewer;
  148. BEGIN v := viewers; WHILE v # NIL DO v.Handle(m); v := v.next END
  149. END Broadcast;
  150.  
  151. (*commands*)
  152.  
  153. PROCEDURE Close*;
  154.     VAR x, y: INTEGER; buttons: SET; v: Viewer;
  155. BEGIN OS.GetMouse(buttons, x, y); v := ViewerAt(y); v.Close
  156. END Close;
  157.  
  158. PROCEDURE Copy*;
  159.     VAR v: Viewer; x, y: INTEGER; buttons: SET;
  160. BEGIN OS.GetMouse(buttons, x, y); v := ViewerAt(y);
  161.     v := New(v.menu.Copy(), v.cont.Copy())
  162. END Copy;
  163.  
  164. BEGIN
  165.     viewers := NIL; focus := NIL
  166. END Viewers0.
  167.